This document contains various maps showing adoption data from the Cincinnati Animal CARE shelter built to help plan for their participation in the Competitive Pet Placement project.
The data visualized here was obtained and processed as follows:
A CAC outcomes report filtered to include only Adoption outcomes from 2020-07-01 through 2023-09-30 served as the raw data.
Some additional cleaning was done, primarily removing apartment numbers from the street address column by removing all characters appearing after a comma.
The file was then geocoded using the Census Geocoder, which also prorvides a Census Tract for each geocoded address. 12189 (95%) out of the 12757 adoption records were geocoded successfully. The rest (which were spread across all years of data) were excluded from the analysis.
LOS was calculated using outcome date minus intake date and grouped into 0-30, 31-90, and 91+ days.
To narrow down the mapping, only addresses from OH (10471), KY (1376), and IN (253) were included, excluding 89 addresses from outside these states. The final dataset contains 12,100 geocoded adoption outcomes.
Census data for all tracts in which adoption outcomes occurred were retrieved from the Census API based on the received guidance - other variables can be added easily.
This first map shows all adoptions in the data (Total) as well as adoptions per 1000 households, to account for the fact that places with more households are expected to have more adoptions. Note that there are a few area with many adoptions and unusually low household count in the census data (I double checked it), not sure what’s going on there but just note that these are by far higher than the rest of the data (as you can see when exploring the map).
# create total adoption
sf_all <-
dfmap %>%
count(GEOID) %>%
left_join(census_df %>% select(GEOID, geometry), by='GEOID') %>% st_as_sf()
# create color palette
pal_all <- colorBin(palette='Purples', domain = sf_all$n, bins = c(0, 20, 40, 80, 160))
# create tooltip label
label_all <- sprintf("Tract %s<br/><strong>%g %s</strong>",
str_sub(sf_all$GEOID,-6,-1), sf_all$n, 'Adoptions') %>% lapply(htmltools::HTML)
# create per households df
sf_percap <-
dfmap %>%
count(GEOID) %>%
left_join(census_df %>% select(GEOID, pop, households, geometry), by='GEOID') %>%
filter(households!=0) %>% # 13 geoids
mutate(per=round(n/households*1000)) %>%
st_as_sf()
# color palette and label - need to adjust for some really high # bc low household count
pal_percap <- colorBin(palette='Purples', domain = sf_percap$per, bins = c(0, 10, 25, 50, 100, 500, 1000))
label_percap <- sprintf("Tract %s<br/><strong>%g %s</strong>", str_sub(sf_percap$GEOID,-6,-1),
sf_percap$per, 'Adoptions per<br/>1000 households') %>% lapply(htmltools::HTML)
# all adoptions map
leaflet() %>%
addTiles() %>%
setView(lat = shelter_lat, lng = shelter_lng, zoom=10) %>% # CAC location
addMarkers(lat = shelter_lat, lng = shelter_lng, label='Cincinnati Animal CARE') %>%
addPolygons(data=fix_sf(sf_all), group='Total', fillColor=~pal_all(n),
fillOpacity = 0.8, color='grey', weight = 1, opacity = 0.4, label = label_all,
highlightOptions = highlightOptions(color = "black",weight = 2, bringToFront = TRUE)) %>%
addPolygons(data=fix_sf(sf_percap), group='Household', fillColor=~pal_percap(per),
fillOpacity = 0.8, color='grey', weight = 1, opacity = 0.4, label = label_percap,
highlightOptions = highlightOptions(color = "black",weight = 2, bringToFront = TRUE)) %>%
addLegend(pal = pal_all, values = sf_all$n, opacity = 0.8, title = 'Total Adoptions',
position = "bottomright", group='Total') %>%
addLegend(pal = pal_percap, values = sf_percap$per, opacity = 0.8, title = 'Adoptions per<br>1000 Households',
position = "bottomleft", group='Household') %>%
addLayersControl(
baseGroups = c('Total','Household'),
options = layersControlOptions(collapsed = FALSE)
) %>%
hideGroup(c('Household'))Each layer shows a heatmap of adoptions that took place in a particular year.
Each layer shows a heatmap of adoptions of animals of each size category. 256 Extra Large animals were merged into Large (2336 animals). There were 4940 Medium and 4568 Small animals in the data.